home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / programming / other / wild / support / metastuff.bas < prev    next >
BASIC Source File  |  1999-05-25  |  7KB  |  285 lines
  1. SCREEN 1,720,455,2,5
  2. WINDOW 1,"METAStuffing ...",(0,0)-(640,400),,1
  3.  
  4. '$INCLUDE BASU:_METAConsts.bas
  5. '$INCLUDE BASU:_CutWord.bas
  6. '$INCLUDE BASU:_LoadMETA.bas
  7. '$INCLUDE BASU:_Prox.bas
  8. '$INCLUDE BASU:_SafeLine.bas
  9. '$INCLUDE BASU:_METAViewTD.bas
  10. '$INCLUDE BASU:_WAITKEY.bas
  11. '$INCLUDE BASU:_MatrixSolve.bas
  12.  
  13. CONST STUCX%=1
  14. CONST STUCY%=2
  15. CONST STUCZ%=3
  16. CONST STUR%=4
  17. CONST STUFACS%=10
  18. CONST STUMAX%=30
  19.  
  20. METAIN$="EscapeLevels:META/ball.META"
  21. LoadMETA(METAIN$)
  22. WILDOUT$="Ram:Stuff.s"
  23. FOR i=1 TO 12
  24.  READ ObjRef(i)
  25. NEXT i
  26. viewmode&=VIEWMODE_WIRE&+VIEWFLAG_SELSHOW&
  27. CurFace=1
  28.  
  29. ST=100
  30. REPEAT cyc
  31. a$=UCASE$(WAITKEY$)
  32. SELECT CASE a$
  33.  CASE "X"
  34.   EXIT cyc
  35.  CASE "["
  36.   ObjRef(REF_O%+REF_X%)=ObjRef(REF_O%+REF_X%)-ST
  37.  CASE "]"
  38.   ObjRef(REF_O%+REF_X%)=ObjRef(REF_O%+REF_X%)+ST
  39.  CASE "-"
  40.   ObjRef(REF_O%+REF_Y%)=ObjRef(REF_O%+REF_Y%)-ST
  41.  CASE "+"
  42.   ObjRef(REF_O%+REF_Y%)=ObjRef(REF_O%+REF_Y%)+ST
  43.  CASE "*"
  44.   ObjRef(REF_O%+REF_Z%)=ObjRef(REF_O%+REF_Z%)+ST
  45.  CASE "9"
  46.   ObjRef(REF_O%+REF_Z%)=ObjRef(REF_O%+REF_Z%)-ST
  47.  CASE "2"
  48.   CALL RotRef(STA,REF_J%,REF_K%)
  49.  CASE "8"
  50.   CALL RotRef(-STA,REF_J%,REF_K%)
  51.  CASE "6"
  52.   CALL RotRef(STA,REF_I%,REF_K%)
  53.  CASE "4"
  54.   CALL RotRef(-STA,REF_I%,REF_K%)
  55.  CASE "5"
  56.   CALL RotRef(STA,REF_I%,REF_J%)
  57. END SELECT
  58. GOSUB Refresh
  59. END REPEAT cyc
  60. GOSUB stuffing
  61. END
  62. Refresh:
  63. CALL METAViewTD
  64. CLS
  65. CALL METARedrawTD(1,1,WINDOW(2),WINDOW(3),viewmode&)
  66. RETURN
  67.  
  68.  
  69. DATA 0,0,1000
  70. DATA 1,0,0
  71. DATA 0,1,0
  72. DATA 0,0,1
  73.  
  74. Stuffing:
  75. DIM Stuff(500,STUMAX%),Usf(10)
  76.  
  77. MAXD&=0:BESTA=0:BESTB=0
  78. FOR i=1 TO NDOT-1
  79.  FOR j=i+1 TO NDOT
  80.   D&=(Dot(i,DOTX%)-Dot(j,DOTX%))^2+(Dot(i,DOTY%)-Dot(j,DOTY%))^2+(Dot(i,DOTZ%)-Dot(j,DOTZ%))^2
  81.   IF D&>MAXD& THEN MAXD&=D&:BESTA=i:BESTB=j
  82.  NEXT j
  83. NEXT i
  84.  
  85. BigSCX=(Dot(BESTA,DOTX%)+Dot(BESTB,DOTX%))/2
  86. BigSCY=(Dot(BESTA,DOTY%)+Dot(BESTB,DOTY%))/2
  87. BigSCZ=(Dot(BESTA,DOTZ%)+Dot(BESTB,DOTZ%))/2
  88. BigSR=MAXD&^.5
  89.  
  90. SUB DrawX(x,y,r,c)
  91.  LINE (x-r,y-r)-(x+r,y+r),c
  92.  LINE (x-r,y+r)-(x+r,y-r),c
  93. END SUB
  94.  
  95. FUNCTION METADistancePointFace(f,x,y,z)
  96.  SHARED Face(),Dot(),hx,hy
  97.  Cx=Dot(Face(f,FACPC%),DOTX%)
  98.  Cy=Dot(Face(f,FACPC%),DOTY%)
  99.  Cz=Dot(Face(f,FACPC%),DOTZ%)
  100.  YOSC=Dot(Face(f,FACPC%),DOTYOS%)
  101.  XOSC=Dot(Face(f,FACPC%),DOTXOS%)
  102.  CALL DrawX(XOSC+hx,YOSC+hy,5,3)
  103.  Ax=Dot(Face(f,FACPA%),DOTX%)-Cx
  104.  Ay=Dot(Face(f,FACPA%),DOTY%)-Cy
  105.  Az=Dot(Face(f,FACPA%),DOTZ%)-Cz
  106.  Bx=Dot(Face(f,FACPB%),DOTX%)-Cx
  107.  By=Dot(Face(f,FACPB%),DOTY%)-Cy
  108.  Bz=Dot(Face(f,FACPB%),DOTZ%)-Cz
  109.  xr=x-Cx
  110.  yr=y-Cy
  111.  zr=z-Cz
  112.  Ik=Bz*Ay-Az*By
  113.  Jk=Az*Bx-Bz*Ax
  114.  Kk=By*Ax-Bx*Ay
  115.  Lk=(Ik^2+Jk^2+Kk^2)^.5
  116.  PS=Ik*xr+Jk*yr+Kk*zr
  117.  d=PS/Lk
  118.  METADistancePointFace=d
  119. END FUNCTION
  120.  
  121. SUB SphereDraw(x,y,z,r)
  122.  SHARED hx,hy,ObjRef()
  123.  mx=x*ObjRef(REF_I%+REF_X%)+y*ObjRef(REF_J%+REF_X%)+z*ObjRef(REF_K%+REF_X%)+ObjRef(REF_O%+REF_X%)
  124.  my=x*ObjRef(REF_I%+REF_Y%)+y*ObjRef(REF_J%+REF_Y%)+z*ObjRef(REF_K%+REF_Y%)+ObjRef(REF_O%+REF_Y%)
  125.  mz=x*ObjRef(REF_I%+REF_Z%)+y*ObjRef(REF_J%+REF_Z%)+z*ObjRef(REF_K%+REF_Z%)+ObjRef(REF_O%+REF_Z%)
  126.  xos=ProX(mx,mz)+hx
  127.  yos=ProY(my,mz)+hy
  128.  ros=ABS((ABS(r)*256)/(mz+256))
  129. ' PRINT "ros ",ros,xos,yos
  130.  CIRCLE (xos,yos),ros,3,,,1
  131. END SUB
  132.  
  133. ' Condizioni per ogni sfera:
  134. ' essere tangente a tre facce almeno, che determinano quasi tutto.
  135. ' poi, trovate le coordinate del centro in funzione del raggio, provare con tutte
  136. ' le altre facce il raggio massimo.
  137. ' novo metodo, più lento probabilmente ma chi se ne frega. 
  138. ' E' lo stesso, solo che faccio un sistema 4x4 per ogni 4 facce, di cui 3 sono
  139. ' le tangenti fisse, la quarta è un ciclo, per trovare il raggio maggiore possibile.
  140. '
  141. ' kax*(cx-oax)+kay*(cy-oay)+kaz*(cz-oaz)=-r    'FIXXXX !!!  -r !!! Normals are pointing OUT !
  142. ' quindi
  143. ' kax*cx+kay*cy+kaz*cz+r=oax*kax+oay*kay+oaz*kaz !!! (bene! è costante !)
  144. ' matrice:
  145. ' |kax kay kaz +1|     |ma|     (ma=oax*kax+oay*...)
  146. ' |kbx kby kbz +1|     |mb|
  147. ' |kcx kcy kcz +1|     |mc|
  148. ' |kfx kfy kfz +1|     |mf|    (f=faccia ciclata)    ; +1 !!!
  149.  
  150. COLOR 1,0
  151. NSTU=0
  152. MINR=20
  153. GOSUB Refresh
  154. FOR i=1 TO NDOT
  155.  NUSF=0
  156.  FOR j=1 TO NFAC
  157.   IF Face(j,FACPA%)=i OR Face(j,FACPB%)=i OR Face(j,FACPC%)=i THEN NUSF=NUSF+1:Usf(NUSF)=j
  158.  NEXT j
  159.  IF NUSF>=3
  160.   rmin=BigSR
  161.   fa=Usf(1)
  162.   fb=Usf(2)
  163.   fc=Usf(3)
  164.  
  165. '  PRINT "Faces: ",fa;fb;fc
  166.   
  167.   axc=Dot(Face(fa,FACPC%),DOTX%)
  168.   ayc=Dot(Face(fa,FACPC%),DOTY%)
  169.   azc=Dot(Face(fa,FACPC%),DOTZ%)
  170.   axa=Dot(Face(fa,FACPA%),DOTX%)-axc
  171.   aya=Dot(Face(fa,FACPA%),DOTY%)-ayc
  172.   aza=Dot(Face(fa,FACPA%),DOTZ%)-azc
  173.   axb=Dot(Face(fa,FACPB%),DOTX%)-axc
  174.   ayb=Dot(Face(fa,FACPB%),DOTY%)-ayc
  175.   azb=Dot(Face(fa,FACPB%),DOTZ%)-azc
  176.   kax=azb*aya-aza*ayb
  177.   kay=aza*axb-azb*axa
  178.   kaz=axa*ayb-aya*axb
  179.   lka=(kax^2+kay^2+kaz^2)^.5
  180.   kax=kax/lka
  181.   kay=kay/lka
  182.   kaz=kaz/lka
  183.   bxc=Dot(Face(fb,FACPC%),DOTX%)
  184.   byc=Dot(Face(fb,FACPC%),DOTY%)
  185.   bzc=Dot(Face(fb,FACPC%),DOTZ%)
  186.   bxa=Dot(Face(fb,FACPA%),DOTX%)-bxc
  187.   bya=Dot(Face(fb,FACPA%),DOTY%)-byc
  188.   bza=Dot(Face(fb,FACPA%),DOTZ%)-bzc
  189.   bxb=Dot(Face(fb,FACPB%),DOTX%)-bxc
  190.   byb=Dot(Face(fb,FACPB%),DOTY%)-byc
  191.   bzb=Dot(Face(fb,FACPB%),DOTZ%)-bzc
  192.   kbx=bzb*bya-bza*byb
  193.   kby=bza*bxb-bzb*bxa
  194.   kbz=bxa*byb-bya*bxb
  195.   lkb=(kbx^2+kby^2+kbz^2)^.5
  196.   kbx=kbx/lkb
  197.   kby=kby/lkb
  198.   kbz=kbz/lkb
  199.   cxc=Dot(Face(fc,FACPC%),DOTX%)
  200.   cycy=Dot(Face(fc,FACPC%),DOTY%)
  201.   czc=Dot(Face(fc,FACPC%),DOTZ%)
  202.   cxa=Dot(Face(fc,FACPA%),DOTX%)-cxc
  203.   cya=Dot(Face(fc,FACPA%),DOTY%)-cycy
  204.   cza=Dot(Face(fc,FACPA%),DOTZ%)-czc
  205.   cxb=Dot(Face(fc,FACPB%),DOTX%)-cxc
  206.   cyb=Dot(Face(fc,FACPB%),DOTY%)-cycy
  207.   czb=Dot(Face(fc,FACPB%),DOTZ%)-czc
  208.   kcx=czb*cya-cza*cyb
  209.   kcy=cza*cxb-czb*cxa
  210.   kcz=cxa*cyb-cya*cxb
  211.   lkc=(kcx^2+kcy^2+kcz^2)^.5
  212.   kcx=kcx/lkc
  213.   kcy=kcy/lkc
  214.   kcz=kcz/lkc                ' fin qui penso sia tutto OK.
  215.                       ' coi vettori normalizzati (lk=1) è meglio.
  216. '  PRINT "ka ",kax,kay,kaz
  217. '  PRINT "kb ",kbx,kby,kbz
  218. '  PRINT "kc ",kcx,kcy,kcz
  219.  
  220. '  PRINT "oa ",axc,ayc,azc
  221. '  PRINT "ob ",bxc,byc,bzc
  222. '  PRINT "oc ",cxc,cycy,czc
  223.  
  224.   ma=axc*kax+ayc*kay+azc*kaz
  225.   mb=bxc*kbx+byc*kby+bzc*kbz
  226.   mc=cxc*kcx+cycy*kcy+czc*kcz
  227.  
  228. FOR f=1 TO NFAC
  229.  IF f<>fa AND f<>fb AND f<>fc  
  230.   fxc=Dot(Face(f,FACPC%),DOTX%)
  231.   fyc=Dot(Face(f,FACPC%),DOTY%)
  232.   fzc=Dot(Face(f,FACPC%),DOTZ%)
  233.   fxa=Dot(Face(f,FACPA%),DOTX%)-fxc
  234.   fya=Dot(Face(f,FACPA%),DOTY%)-fyc
  235.   fza=Dot(Face(f,FACPA%),DOTZ%)-fzc
  236.   fxb=Dot(Face(f,FACPB%),DOTX%)-fxc
  237.   fyb=Dot(Face(f,FACPB%),DOTY%)-fyc
  238.   fzb=Dot(Face(f,FACPB%),DOTZ%)-fzc
  239.   kfx=fzb*fya-fza*fyb
  240.   kfy=fza*fxb-fzb*fxa
  241.   kfz=fxa*fyb-fya*fxb
  242.   lkf=(kfx^2+kfy^2+kfz^2)^.5
  243.   kfx=kfx/lkf
  244.   kfy=kfy/lkf
  245.   kfz=kfz/lkf
  246.   
  247.   mf=fxc*kfx+fyc*kfy+fzc*kfz
  248.  
  249. ' kax*(cx-oax)+kay*(cy-oay)+kaz*(cz-oaz)=-r
  250. ' kax*cx+kay*cy+kaz*cz+r=oax*kax+oay*kay+oaz*kaz !!! (bene! è costante !)
  251. ' matrice:
  252. ' |kax kay kaz 1|     |ma|     (ma=oax*kax+oay*...)
  253. ' |kbx kby kbz 1|     |mb|
  254. ' |kcx kcy kcz 1|     |mc|
  255. ' |kfx kfy kfz 1|     |mf|    (f=faccia ciclata)
  256.  
  257.   Ko(1,1)=kax:Ko(2,1)=kay:Ko(3,1)=kaz:Ko(4,1)=1:Tn(1)=ma
  258.   Ko(1,2)=kbx:Ko(2,2)=kby:Ko(3,2)=kbz:Ko(4,2)=1:Tn(2)=mb
  259.   Ko(1,3)=kcx:Ko(2,3)=kcy:Ko(3,3)=kcz:Ko(4,3)=1:Tn(3)=mc
  260.   Ko(1,4)=kfx:Ko(2,4)=kfy:Ko(3,4)=kfz:Ko(4,4)=1:Tn(4)=mf
  261.   CALL Solve4x4 
  262.  
  263.   cxf=So(1)
  264.   cyf=So(2)
  265.   czf=So(3)
  266.   r=So(4)
  267.   IF r>0 AND r<rmin THEN rmin=r:cx=cxf:cy=cyf:cz=czf
  268.  END IF
  269. NEXT f
  270.  r=rmin
  271.  IF r<0 THEN r=0
  272.  PRINT "r,x,y,z",r,cx,cy,cz
  273.  CALL SphereDraw(cx,cy,cz,r)
  274.  PRINT "dfa ",METADistancePointFace(fa,cx,cy,cz)
  275.  PRINT "dfb ",METADistancePointFace(fb,cx,cy,cz)
  276.  PRINT "dfc ",METADistancePointFace(fc,cx,cy,cz)
  277.  END IF
  278. NEXT i
  279.  
  280.  
  281.  
  282.  
  283.   
  284.  
  285.